Datenanalyse
Nadja Herrmann
1 Einleitung
In diesem Notebook werden die Daten, welche in dem Notebook Datenintegration vorbereitet wurden, mit Hilfe von Visualisierungen analysiert. Dies ist der erste Teil des gewünschten Outputs des Projektes (siehe Abbildung 1).
Abbildung 1: Konzeptionelles Vorgehen, Eigene Darstellung 2021
2 Vorbereitung
2.1 Notwendige Pakete laden
In diesem Notebook werden die folgenden Pakete verwendet:
library(tidyverse)
library(ggplot2)
library(plotly)
library(scales)
library(lubridate)
library(DT)2.2 Daten importieren
Der in Abschnitt Datenintegration erstellte Datensatz mobility_vaccine wird für dieses Notebook Datenanalyse herangezogen.
mobility_vaccine <- read.csv("../Website/Daten_Output/Mobility_vaccine.csv")2.3 Beschreibung des finalen Datensatzes
glimpse(mobility_vaccine)## Rows: 27,888
## Columns: 17
## $ X <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 1~
## $ date <chr> "2020-12-27", "2020-12-27", "2020-12-27", "2020-~
## $ Bundesland <chr> "Baden-Württemberg", "Baden-Württemberg", "Bayer~
## $ ID <int> 8, 8, 9, 11, 12, 4, 4, 2, 6, 6, 13, 3, 5, 5, 7, ~
## $ Impfstoff <chr> "Comirnaty", "Moderna", "Comirnaty", "Comirnaty"~
## $ Impfserie <int> 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 2, 1, 1, ~
## $ Anzahl <int> 2610, 3, 3606, 1770, 28, 3, 511, 443, 2, 2712, 3~
## $ Einwohner_2020 <int> 11103043, 11103043, 13140183, 3664088, 2531071, ~
## $ country_region_code <chr> "DE", "DE", "DE", "DE", "DE", "DE", "DE", "DE", ~
## $ country_region <chr> "Germany", "Germany", "Germany", "Germany", "Ger~
## $ iso_code <chr> "DE-BW", "DE-BW", "DE-BY", "DE-BE", "DE-BB", "DE~
## $ retail_and_recreation <int> -68, -68, -68, -74, -61, -77, -77, -75, -68, -68~
## $ grocery_and_pharmacy <int> -39, -39, -41, -39, -37, -39, -39, -32, -40, -40~
## $ parks <int> -5, -5, -5, -38, -12, -45, -45, -50, -12, -12, -~
## $ transit_stations <int> -53, -53, -55, -56, -41, -61, -61, -61, -56, -56~
## $ workplaces <int> -30, -30, -27, -29, -20, -30, -30, -31, -27, -27~
## $ residential <int> 8, 8, 8, 8, 6, 8, 8, 8, 8, 8, 6, 8, 8, 8, 8, 8, ~Der ursprüngliche Datensatz besteht aus 17 Variablen. Einige der Variablen werden für das Dashboard (Output Teil 2) verwendet, sind aber für die folgende Analyse nicht relevant. Deshalb werden diese Variablen im nächsten Schritt entfernt.
excluded_vars <- c("X", "country_region_code", "country_region", "iso_code", "ID", "Impfserie")
mobility_vaccine <- select(mobility_vaccine, -excluded_vars)no_cols<- ncol(mobility_vaccine)no_rows<- nrow(mobility_vaccine)Der finale Datensatz mobility_vaccine besteht aus 11 Spalten und 27888 Zeilen. In der folgenden Tabelle werden die Variablen und ihre Merkmale beschrieben.
| Variable | Beschreibung | Datentyp |
|---|---|---|
| date | Datum | Character |
| bundesland | Bundesland | Character |
| ID | Bundesland_ID | Integer |
| Impfstoff | Impfstoff verwendet | Character |
| Impfserie | Serie Impfstoff verwendet | Integer |
| Anzahl | Anzahl Impfungen pro Tag | Integer |
| Einwohner_2020 | Einwohnerzahl pro Bundesland | Integer |
| retail_and_recreation | Einzelhandel und Erholung | Integer |
| grocery_and_pharmacy | Lebensmittel und Apotheken | Integer |
| parks | Park (z.B.: Öffentlicher Park, Schloss, Waldgebiete | Integer |
| transit_stations | Transitstationen | Integer |
| workplaces | Arbeitsstätten | Integer |
| residential | Haus und Wohnungen | Integer |
Die Funktion ymd wandelt in Zeichen- und numerischen Vektoren gespeicherte Daten in Date- oder POSIXct-Objekte um. Im nächsten Schritt wird der Character date umgewandelt.
mobility_vaccine$date <- ymd(mobility_vaccine$date)Im nächsten Schritt wird eine zusätzliche Spalte mit der Bezeichnung year_month erstellt. Somit können Visualisierungen für den gesamten Zeitraum auf Monatsebene erstellt werden.
mobility_vaccine <- mobility_vaccine %>%
mutate(date_2 = date)%>%
separate(date_2, c("Year", "Month", "Day"), sep="-")%>%
unite(year_month, c(Year, Month), sep = "/", remove = FALSE)Da der Impfstoff Janssen nach einer einmaligen Impfung den vollen Impfstoff bietet, werden die weiteren Impfstoffe (mind. 2 Impfungen Stand heute) durch 2 geteilt. Somit kann der Impffortschritt besser verglichen werden.
mobility_vaccine <-mobility_vaccine %>%
mutate(impf_fortschritt = case_when(Impfstoff == "Comirnaty" ~ Anzahl/2,
Impfstoff == "AstraZeneca" ~ Anzahl/2,
Impfstoff == "Moderna" ~ Anzahl/2,
Impfstoff == "Janssen" ~ Anzahl*1))Um das Verhältnis der Impfungen in Relation zu den Einwohnerzahlen zur bringen, wird als nächstes die Impfquote berechnet.
mobility_vaccine <-mobility_vaccine %>%
mutate(impf_quote = (impf_fortschritt/Einwohner_2020)*100)Das R-Paket DT bietet eine R-Schnittstelle zur JavaScript-Bibliothek DataTables. R-Datenobjekte (Matrizen oder Datenrahmen) können als Tabellen auf HTML-Seiten angezeigt werden, und DataTables bietet Filterung, Paginierung, Sortierung und viele andere Funktionen in den Tabellen.
Der für die Analyse herangezogene Datensatz wird im Folgenden als DataTable gezeigt:
mobility_vaccine_head <- mobility_vaccine%>% slice(1:50)
datatable(mobility_vaccine_head, filter = 'top', options = list(
pageLength = 5, autoWidth = TRUE
)) %>%
formatDate('date', 'toDateString') %>%
formatCurrency(c('retail_and_recreation','grocery_and_pharmacy', 'parks', 'transit_stations', 'workplaces','residential'), '%') %>%
formatPercentage('impf_quote',2)3 Analyse des finalen Datensatzes
3.1 Betrachtungszeitraum
Der Betrachtungszeitraum für die Analyse liegt zwischen dem 27.12.2020 - 15.10.2021.
mobility_vaccine %>%
select(date) %>%
summarise(max = max(date, na.rm = TRUE), min = min(date, na.rm = TRUE))## max min
## 1 2021-10-15 2020-12-273.2 Deutschland Impfung gesamt
summe_impfungen_gesamt <-mobility_vaccine %>%
summarise(
sum_impfungen = sum(Anzahl))In dem Zeitraum vom 27.12.2020 bis 15.10.2021 wurden in Deutschland 109521652 Impfungen verabreicht.
3.3 Deutschland Impfung pro Jahr
In 2020 wurden in Summe 207.060 Impfungen verabreicht, während in 2021 bis zum 15.10.2021 in Summe 109.314.592 Impfungen verabreicht wurden (inkl. Zweitimpfung).
graph_0 <- mobility_vaccine %>%
group_by(Year) %>%
summarise(summe_pro_jahr = sum(Anzahl)) %>%
ggplot(aes(x = Year, y = summe_pro_jahr))+
geom_col(colour="darkslategray", fill = "darkslategray4")+
theme_classic()+
scale_y_continuous(labels = function(x) format(x, big.mark = ".",
scientific = FALSE)) +
labs(
title = "Covid Impfungen gesamt nach Jahr",
y = element_blank(),
x = element_blank()
)
ggplotly(graph_0)3.4 Welcher Impfstoff wurde am häufigsten verabreicht?
Der Impfstoff Biontech/Comirnaty wurde in Summe am häufigsten verabreicht (84.047.591). Von dem Impfstoff AstraZeneca wurden 12.670.077 Dosen geimpft, Moderna folgt mit 9.553.672 Impfungen und Janssen mit 3.250.312 Dosen. Die Grafik zeig deutlich, dass es große Unterschiede in der Impfstoffverteilung gibt. Bemerkenswert ist der deutliche Abstand zwischen dem Impfstoff Comirnaty und den anderen drei Impfstoffen. AstraZeneca und Moderna haben ähnlich große Anteile an der Impfstoffverteilung. Janssen hat einen sehr geringen Anteil, welcher deutlich weniger als 10% bei den Impfungen ausmacht. Da mit AstraZeneca ein Vektorimfpstoff auf Platz 2 steht ist es unwahrscheinlich, dass das zugrunde liegende Impfverfahren einen relevanten Einfluss hat (mRNA- oder Vektorimpfstoff). Einflüssgrößen für diese ungleiche Verteilung könnten unter anderem die Verfügbarkeit, Wirksamkeit, Marketing oder Nebenwirkungen sein. Da die Impfung nicht kostenpflichtig ist, sind die Kosten als Einflussgröße zu vernachlässigen.
graph_1 <- mobility_vaccine %>%
group_by(Impfstoff) %>%
summarise(summe_impfungen = sum(Anzahl)) %>%
ggplot(aes(x = Impfstoff, y=summe_impfungen))+
geom_col(colour="darkslategray", fill = "darkslategray4")+
theme_classic()+
scale_y_continuous(labels = function(x) format(x, big.mark = ".",
scientific = FALSE)) +
labs(
title = "Anzahl Impfungen nach Impfstoff",
y = element_blank(),
x = element_blank(),
)
ggplotly(graph_1) Die folgende Grafik zeigt die Verteilung der Impfstoffe pro Jahr. Auffällig ist, dass in dem Jahr 2020 kein Impfstoff der Firma Janssen verwendet wurde. Dies lässt darauf schließen, dass Moderna, Comirnaty und AstraZeneca die ersten freigegebenen Impfstoffe waren. In 2021 fällt, wie in der vorhergehenden Grafik, der große Anteil des Impfstoffs Cominaty auf.
graph_2 <- mobility_vaccine %>%
group_by(Year, Impfstoff) %>%
summarise(Impfungen = sum(Anzahl))%>%
ggplot(aes(x = Year, y = Impfungen, group = Impfstoff, colour = Impfstoff, fill = Impfstoff))+
geom_col(size=1.2)+
scale_y_continuous(labels = function(x) format(x, big.mark = ".",
scientific = FALSE))+
theme_minimal()+
labs(
title = "Anzahl Impfungen nach Impfstoff pro Jahr",
y = element_blank(),
x = element_blank()
)## `summarise()` has grouped output by 'Year'. You can override using the `.groups` argument.ggplotly(graph_2)3.5 Impfungen zeitlicher Verlauf (pro Monat & Jahr)
Mit Hilfe der folgenden Funktion wird die Anzahl der Impfungen pro Monat aufgezeigt. Auf der x-Achse ist dabei der Zeitraum in Monaten dargestellt. Auf der y-Achse sind die Impfzahlen mit einer Skala von 0 bis 25 Millionen dargestellt.
Das Histogramm zeigt deutlich, dass die Impfungen von Dezember 2020 bis Juni 2021 relativ kontinuierlich ansteigen. Das Maximum liegt im Juni bei fast 25 Millionen Impfungen. Im Zeitraum Juli bis Oktober verlaufen die Impfzahlen mit einem ähnlich kontinuierlichen Verlauf in die negative Richtung wie im Zeitraum zwischen Dezember 20 und Juni 21. Im Oktober 21 liegt die die Anzahl der Impfungen pro Monat wieder unter 2,5 Millionen. Dies könnte durch den sinkenden Bedarf aufgrund des größer werdenden Anteils an vollständig geimpften Menschen erklärt werden, sowie aufgrund des ausgewählten Zeitraums. Der kontinuierliche Anstieg zu Beginn des Jahres könnte auf den hohen Bedarf bei den Menschen und kontinuierliche Steigerung des Impfangebots bis zur Mitte des Jahres zurückgeführt werden. Ab Mitte des Jahres könnte sich der Effekt umgekehrt haben, weshalb die Impfzahlen wieder sinken. Insgesamt erinnert der Verlauf an eine typische Marktsättigung bei der eine hohe Nachfrage erst durch kontinuierliche Erhöhung des Angebots bedient werden kann und anschließend eine Sättigung und Rückgang der Nachfrage eintritt.
Der Impfverlauf zeigt ebenfalls welche Impfstoffe, in welchem Monat, in welcher Anzahl geimpft wurden. Moderna nur in Hochzeiten, genauso wie Janssen.
graph_3 <-mobility_vaccine %>%
group_by(year_month, Impfstoff) %>%
summarise(Impfungen = sum(Anzahl)) %>%
ggplot(aes(x = year_month, y = Impfungen, group = Impfstoff, colour = Impfstoff, fill = Impfstoff))+
geom_col()+
scale_y_continuous(labels = comma_format(big.mark = ".",
decimal.mark = ","))+
theme_minimal()+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
labs(
title = "Anzahl Covid Impfungen",
y = "Anzahl",
x = element_blank()
)## `summarise()` has grouped output by 'year_month'. You can override using the `.groups` argument.ggplotly(graph_3)3.6 Deutschland Impfung pro Bundesland
Die folgende Funktion zeigt die Anzahl der Impfungen in Abhängigkeit zum jeweiligen Bundesland. Dabei ist auf der y-Achse die Anzahl der Impfungen angezeigt und auf der x-Achse die Bundesländer der Bundesrepublik Deutschland. Die höchste Anzahl an Impfungen wurde in Nordhrein-Westfalen durchgeführt. Die niedrigste Anzahl an Impfungen liegt in Bremen. Insgesamt scheint die Anzahl der Impfungen proportional zur Einwohnerzahl zu sein, denn die bevölkerungsstärksten Bundesländer haben die höchsten Werte bei den Impfzahlen. Daraus lässt sich schließen, dass es keine nennenswerten Unterschiede zwischen den Bundesländer in der Impfbereitschaft oder Verfügbarkeit der Impfsstoffe gibt.
graph_4 <-mobility_vaccine %>%
group_by(Bundesland) %>%
summarise(sum_impfungen = sum(Anzahl),
min_anzahl = min(Anzahl),
mean_anzahl = mean(Anzahl)) %>%
ggplot(aes(x = reorder(Bundesland, -sum_impfungen), y = sum_impfungen))+
geom_col(size=1.2, colour="darkslategray", fill = "darkslategray4")+
scale_y_continuous(labels = function(x) format(x, big.mark = ".",
scientific = FALSE))+
theme_minimal()+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
labs(
title = "Anzahl Covid Impfungen pro Bundesland",
y = element_blank(),
x = element_blank()
)
ggplotly(graph_4)In der DataTable Einwohner sind die Einwohnerzahlen pro Bundesland aufgelistet:
einwohner <- mobility_vaccine %>%
distinct(Bundesland, Einwohner_2020)
datatable(einwohner)3.7 Impfquote
Im Gegensatz zur vorher gezeigten reinen Anzahl der Impfungen pro Bundesland, zeigt die folgende Grafik die Anzahl der Impfungen pro Bundesland in Bezug zur Einwohnerzahl. Mit der Impfquote lässt sich die Impfleistung pro Bundesland bewerten und die Bundesländer unabhängig von ihrer Größe vergleichen. Die Impfquote ist in der Grafik auf der y-Achse dargestellt und die Bundesländer auf der x-Achse.
Der Wertbereich liegt zwischen ca. 80% und 58%. Es fällt auf, dass in Bremen die höchste Impfquote herrscht obwohl die absolute Impfzahl am nierdigsten ist (siehe ## Deutschland Impfung pro Bundesland). Auf der anderen Seite hat Sachsen, mit relativ geringer Einwohnerzahl, die niedrigste Impfquote. Betrachtet man auch die Impfquote von der bevölkerunsstärksten Bundesländern NRW, BW und Bayern fällt auf, dass das Niveau der Impfquoten verteilt ist. Während NRW im oberen Bereich mit 72% liegt, liegen BW und Bayern gleichauf im unteren Bereich mit ca.65%. Aus diesen Beobachtungen lässt sich schließen, dass die Bevölkerungszahl keinen wesentlichen Einfluss auf die Impfleistung hat.
graph_6 <- mobility_vaccine %>%
group_by(Bundesland) %>%
summarise(quote = sum(impf_quote)) %>%
ggplot()+
geom_point(aes(x = reorder(Bundesland, -quote), y = quote), size=2, colour="darkslategray")+
geom_col(aes(x = reorder(Bundesland, -quote), y = quote), colour="darkslategray4", fill="darkslategray4")+
scale_y_continuous(labels = comma_format(big.mark = ".",
decimal.mark = ","))+
theme_minimal()+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
labs(
title = "Impfquote pro Bundesland",
y = "Impfquote [%]",
x = element_blank()
)+ylim(0,100)## Scale for 'y' is already present. Adding another scale for 'y', which will
## replace the existing scale.ggplotly(graph_6)3.8 Mobilitätsaufkommen im Bereich Einzelhandel und Freizeit
Die folgenden Daten zeigen das Mobilitätsaufkommen in dem Zeitraum von Dezember 2020 bis Oktober 2021 im Bereich Einzelhandel und Freizeit. Das Mobilitätsaufkommen wird als prozentuale Abweichung von einem Referenzwert auf der y-Achse angegeben. Der Referenzwert ist der Median aus dem Zeitraum Januar bis Februar 2020. Deshalb sind die saisonalen Änderungen (Wetter) und der Einfluss durch spätere Corona-Maßnahmen in der Analyse zu berücksichtigen.
Auf der x-Achse ist der Zeitraum dargestellt. Die einzelnen Datenpunkte sind die Ergebnisse aus den einzelnen Bundesländern. Deshalb gibt es mehrere Punkte für ein Datum. Dabei fällt auf, dass die Werte der einzelnen Bundesländer stark voneinander abweichen. Insbesonders in den Monaten Juni 21 bis Oktober 21 gibt es Bundesländer mit starken Ausreisern nach oben.
Insgesamt ist erkennbar, dass das Mobilitätsaufkommen von Januar bis Juni aus dem negativen Bereich von ca. -50% auf den Referenzwert (0%) ansteigt. Hierbei ist die Streuung zwischen den Bundesländern gering. In diesem Zeitraum könnten die teilweise starken Corona-Einschränkungen bei Freizeitaktivitäten einen Einfluss gehabt haben. Die Saisonalität spielt insbesonders im Januar und Februar eine untergeordnete Rolle, da die Referenzdaten ebenfalls aus dieser Jahreszeit stammen.
In den Monaten Juni bis Oktober schwankt das Mobilitätsaufkommen um den Referenzwert. Dabei ist die Streuung zwischen den Bundesländern sehr hoch. Im Zeitraum August bis September gibt es starke Ausreisser nach oben. Die Corona-Einschränkungen sind in diesem Zeitraum stark zurückgenommen worden. Dies könnte eine Begründung für den gesamten Anstieg des Mobilitätsaufkommens auf ein Normalniveau sein. Eine Begründung für die hohe Streuung in den Bundesländern könnte ein Zusammenhang zwischen der trotzdem anhaltenden pandemischen Lage und der Saisonalität der Referenzdaten sein. Die These hierzu wäre, dass das Mobilitätsaufkommen im Freizeitbereich in einem Sommer ohne Pandemie grundsätzlich höher ist als im Winter als die Referenzdaten gebildet wurden. In dieser These könnten die Ausreisser den “Normalwert” abbilden und in einigen Bundesländern das Mobilitätsverhalten durch die Pandemie weiterhin beschränkt sein.
Zusammengefasst könnte die pandemische Lage den saisonalen Effekt durch die Erhebung der Referenzdaten im Winter ausgleichen. Dies kann jedoch in dieser Analyse nicht bestätigt werden. Hierzu reichen die vorliegenden historischen Daten zur Mobilität nicht aus. Im Ergebnis kann jedoch festgehalten werden, dass das Mobiltätsaufkommen im Sommer 2021 im Großteil der Bundesländer auf dem Niveau von Januar 2020 lag. Darüber hinaus ist festzuhalten, dass das Mobilitätsaufkommen im Winter 2021 deutlich eingeschränkt war und ca. 50% unter dem Referenzwert lag.
graph_8 <- ggplot(mobility_vaccine, aes(x = date, y = retail_and_recreation)) +
geom_point(size = 0.8)+
scale_x_date(labels = date_format("%b %y"),
date_breaks = ("1 month"))+
theme_classic()+
geom_hline(yintercept=0, linetype="dashed", color = "grey")+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
labs(
y = "Abweichung zum Referenzwert [%]",
x = element_blank()
)
ggplotly(graph_8) %>%
layout(title = list(text = paste0("Mobilitätsaufkommen",
'<br>',
'<sup>',
"Einzelhandel und Erholung",'</sup>')))Aufgrund der großen Unterschiede im Mobilitätsaufkommen zwischen den Bundesländern wird in der folgenden Grafik analysiert welche Bundesländer für die Abweichungen verantwortlich sind. Dafür wird der vorherigen Funktion die Dimension Bundesland hinzugefügt. Durch diese Funktion lässt sich das Mobilitätsaufkommen pro Bundesland für den gleichen Zeitraum darstellen. Durch die isolierte Betrachtung kann festegestellt werden, dass die Ausreisser hauptsächlich auf die Bundesländer Mecklenburg-Vorpommern und Schleswig-Holstein zurückzuführen sind.
Geographisch sind diese beiden Bundesländer typische Urlaubsziele. Durch die eingeschränkten internationalen Reisemöglichkeiten könnten viele Einwohner in diese Regionen zum Urlaub ausgewichen sein und dadurch das Mobilitätsaufkommen im Gegensatz zu den anderen Bundensländern trotz der Pandemie angehoben haben. Der Effekt durch die Saisonalität der Referenzdaten aus dem Winter könnte diese Ausreisser verstärkt haben, da im Winter in den Ferienorten insgesamt deutlich weniger Andrang sein wird.
graph_9 <- ggplot(mobility_vaccine, aes(x = date, y = retail_and_recreation, fill = Bundesland, color = Bundesland)) +
geom_point(size = 0.8)+
scale_x_date(labels = date_format("%b %y"),
date_breaks = ("1 month"))+
theme_classic()+
geom_hline(yintercept=0, linetype="dashed", color = "grey")+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
labs(
y = "Abweichung zum Referenzwert [%]",
x = element_blank()
)
ggplotly(graph_9) %>%
layout(title = list(text = paste0("Mobilitätsaufkommen",
'<br>',
'<sup>',
"Einzelhandel und Erholung",'</sup>')))3.9 Mobilitätsaufkommen im Bereich Lebensmittelhandel und Apotheken
Nach dem gleichen Vorgehen erfolgt die Untersuchung der Mobilitätsdaten im Bereich Lebensmittelhandel und Apotheken. Es zeigt sich, dass das Mobilitätsaufkommen der meisten Bundesländern im Bereich des Referenzwertes liegen und zum Sommer hin leicht darüber liegen. Es lässt sich vermuten, dass die Corona-Einschränkungen in diesem Bereich weniger Einfluss haben. Wie in der vorherigen Darstellung stellen Mecklenburg-Vorpommern und Schleswig-Holstein Ausreiser nach oben dar. Dies lässt darauf schließen, dass die Saisonalität der Daten auch die Frequentierung von Lebensmittelfachgeschäften sowie Apotheken in Ferienorten beeinflusst.
graph_10 <- ggplot(mobility_vaccine, aes(x = date, y = grocery_and_pharmacy, fill = Bundesland, color = Bundesland)) +
geom_point(size = 0.8)+
scale_x_date(labels = date_format("%b %y"),
date_breaks = ("1 month"))+
theme_classic()+
geom_hline(yintercept=0, linetype="dashed", color = "grey")+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
labs(
y = "Abweichung zum Referenzwert [%]",
x = element_blank()
)
ggplotly(graph_10) %>%
layout(title = list(text = paste0("Mobilitätsaufkommen",
'<br>',
'<sup>',
"Apotheken & Lebensmittelhandel",'</sup>')))3.10 parks
Nach dem gleichen Vorgehen erfolgt die Untersuchung der Mobilitätsdaten im Bereich Parks und Naherholungsgebiete. Die Daten zur Mobilität für diesen Bereich zeigen einen ähnlichen Verlauf wie die vorherigen Auswertungen. Insgesamt ist das Mobilitätsaufkommen ab Juni 2021 leicht über dem Referenzwert. Die Abweichung ist jedoch bis auf die Ausreiser gering. Auch die Werte der Ausreiser verhalten sich wie in den vorher beschriebenen Auswertungen zum Einzel- und Lebensmittelhandel. Die geringe Abweichung vom Referenzwert und leichte Abweichung nach oben im Sommer lassen auf eine rein saisonale Abweichung schließen. Corona-Maßnahmen dürften im Fall der Parks keinen großen Einfluss haben. Dies zeigen auch die Daten.
graph_11 <- ggplot(mobility_vaccine, aes(x = date, y = parks, fill = Bundesland, color = Bundesland)) +
geom_point(size = 0.8)+
scale_x_date(labels = date_format("%b %y"),
date_breaks = ("1 month"))+
theme_classic()+
geom_hline(yintercept=0, linetype="dashed", color = "grey")+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
labs(
y = "Abweichung zum Referenzwert [%]",
x = element_blank()
)
ggplotly(graph_11) %>%
layout(title = list(text = paste0("Mobilitätsaufkommen",
'<br>',
'<sup>',
"Parks und Naherholungsgebiete",'</sup>')))3.11 Transitstationen
Nach dem gleichen Vorgehen erfolgt die Untersuchung der Mobilitätsdaten im Bereich Transitstationen. Insgesamt zeigt die Grafik einen sehr ähnlichen Verlauf wie die Grafik zum Einzelhandel. Die Mobilät steigt von Jan 21 bis Jun 21 vom negativen Bereich bis zum Referenzwert. Die Ausreisser verhalten sich ebenfalls genauso wie im Bereich des Einzelhandels. Diese Verbindung könnte darauf zurückgeführt werden, das viele Menschen öffentliche Verkersmittel nutzen für den Besuch des Einzelhandels und auch bei Lockdowns weniger Angestellte unterwegs sind.
graph_12 <- ggplot(mobility_vaccine, aes(x = date, y = transit_stations, fill = Bundesland, color = Bundesland)) +
geom_point(size = 0.8)+
scale_x_date(labels = date_format("%b %y"),
date_breaks = ("1 month"))+
theme_classic()+
geom_hline(yintercept=0, linetype="dashed", color = "grey")+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
labs(
y = "Abweichung zum Referenzwert [%]",
x = element_blank()
)
ggplotly(graph_12) %>%
layout(title = list(text = paste0("Mobilitätsaufkommen",
'<br>',
'<sup>',
"Transitstationen",'</sup>')))3.12 Arbeitsplatz
Nach dem gleichen Vorgehen erfolgt die Untersuchung der Mobilitätsdaten im Bereich Arbeitsplatz. Insgesamt zeigt die Grafik eine sehr breite Streuung der Werte. Es zeigt sich jedoch, dass das Mobilitätsniveau unter dem Referenzwert liegt, da die meisten Datenpunkte unterhalb des Referenzwerts liegen. Deutlich zu erkennen sind die Ferienzeiten in den einzelnen Bundesländern, da das Mobilitätsaufkommen in dieser Zeit Einbrüche zeigt.
graph_13 <- ggplot(mobility_vaccine, aes(x = date, y = workplaces, fill = Bundesland, color = Bundesland)) +
geom_point(size = 0.8)+
scale_x_date(labels = date_format("%b %y"),
date_breaks = ("1 month"))+
theme_classic()+
geom_hline(yintercept=0, linetype="dashed", color = "grey")+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
labs(
y = "Abweichung zum Referenzwert [%]",
x = element_blank()
)+ylim(-100,100)
ggplotly(graph_13) %>%
layout(title = list(text = paste0("Mobilitätsaufkommen",
'<br>',
'<sup>',
"Arbeitsplatz",'</sup>')))3.13 residential
Anders als in der vorherigen Grafik ist bei dem Mobilitätsverhalten in Wohngebieten ersichtlich, dass sich dieses nah am Referenzwert befindet. Lediglich in den Sommermonaten zeigt sich ein leicht in den negativen Bereich abweichendes Verhalten. Dies kann ein Indiz für die Urlaubszeit sein. In den kälteren Monaten ist ein leicht positiver Trend zu verzeichnen.
graph_14 <- ggplot(mobility_vaccine, aes(x = date, y = residential, fill = Bundesland, color = Bundesland)) +
geom_point(size = 0.8)+
scale_x_date(labels = date_format("%b %y"),
date_breaks = ("1 month"))+
theme_classic()+
geom_hline(yintercept=0, linetype="dashed", color = "grey")+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
labs(
y = "Abweichung zum Referenzwert [%]",
x = element_blank()
)+ylim(-100,100)
ggplotly(graph_14) %>%
layout(title = list(text = paste0("Mobilitätsaufkommen",
'<br>',
'<sup>',
"Wohngebiete",'</sup>')))3.14 Mobilitätsaufkommen vs. Impfungen
In den folgenden Grafiken ist das Mobilitätsverhalten für die unterschiedlichen Kategorien (Mittelwert) gegenüber dem Impfverlauf (kumulierte Anzahl der Impfungen) dargestellt. Auf der Y-Achse ist die Abweichung zum Referenzwert in Prozent abgetragen. Auf der x-Achse ist der zeitliche Verlauf (zweiwöchig) dargestellt. Mit Hilfe der Sekundärachse (Y-Achse rechts) wird die Anzahl der Impfungen kumuliert in Millionen aufgezeigt.
Über alle Kategorien hinweg ist ersichtlich, dass die Anzahl an Impfungen zwischen März und August stark ansteigt und die Steigung der Kurve ab September schwächer wird.
Das Mobilitätsverhalten pro Kategorie wurde im vorherigen Abschnitt detailliert beschrieben und analysiert. Zusammenfassend ist ersichtlich, dass das Mobilitätsaufkommen zwischen Januar und Juni unterhalb des Referenzwert liegt und sich in den Sommermonaten stabilisiert hat.
In den folgenden Grafiken ist zu erkennen, dass sich die Kurve des Impfverlaufs ähnlich verhält wie der Trend des Mobilitätsverhaltens. Besonders in den Kategorien: retail_and_recreation, grocery_and_pharmacy, parks und transit_stations. Hier ist ein positiver Trend über den Mittelwert zu erkennen. Bei den Kategorien workplaces wurde in der vorherigen Betrachtung eine große Streuung festgestellt und deshalb ist hier der Mittelwert nicht aussagegräftig. Grundsätzlich lässt sich hier kein Zusammenhang der beiden Variablen erkennen. Bei der Kategorie residential lässt sich ein Zusammenhang erkennen, da die Kurve mit Anstieg des Impfverlaufes einen leichten negativen Trend aufweist. Wie bereits erwähnt, kann der positive Trend der Kategorien ebenfalls auf die Urlaubszeit bzw. auf die Sommerzeit zurückgeführt werden. Um detaillierte Aussagen treffen zu können müssten im weiteren Verlauf zum Beispiel die Wetterdaten oder auch die Covid Daten ergänzt werden.
mobility_vaccine %>%
group_by(date) %>%
summarise(max = mean(retail_and_recreation),
sum = sum(Anzahl)) %>%
summarise(max = max,
sum = cumsum(sum),
date = date) %>%
ggplot()+
geom_line(aes(x = date, y = max), size = 0.8, color = "darkslategray")+
geom_line(aes(x = date, y = sum/1000000), size = 0.8, color = "darkslateblue")+
geom_point(aes(x = date, y = sum/1000000), size = 0.8, color = "darkslateblue")+
geom_hline(yintercept=0, linetype="dashed", color = "grey")+
scale_y_continuous(sec.axis = sec_axis(~.*1,name = "Anzahl Impfungen kumuliert [Mio]"))+
scale_x_date(labels = date_format("%b %y"),
date_breaks = ("2 weeks"))+
theme_classic()+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
labs(
title = "Mobilitätsaufkommen vs Impfverlauf",
subtitle = "Einzelhandel & Erholung",
y = "Abweichung zum Rezerenzwert [%]"
)
mobility_vaccine %>%
group_by(date) %>%
summarise(max = mean(grocery_and_pharmacy),
sum = sum(Anzahl)) %>%
summarise(max = max,
sum = cumsum(sum),
date = date) %>%
ggplot()+
geom_line(aes(x = date, y = max), size = 0.8, color = "darkslategray")+
geom_line(aes(x = date, y = sum/1000000), size = 0.8, color = "darkslateblue")+
geom_point(aes(x = date, y = sum/1000000), size = 0.8, color = "darkslateblue")+
geom_hline(yintercept=0, linetype="dashed", color = "grey")+
scale_y_continuous(sec.axis = sec_axis(~.*1,name = "Anzahl Impfungen kumuliert [Mio]"))+
scale_x_date(labels = date_format("%b %y"),
date_breaks = ("2 weeks"))+
theme_classic()+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
labs(
title = "Mobilitätsaufkommen vs Impfverlauf",
subtitle = "Apotheken & Lebensmittelhandel",
y = "Abweichung zum Rezerenzwert [%]"
)
mobility_vaccine %>%
group_by(date) %>%
summarise(max = mean(parks),
sum = sum(Anzahl)) %>%
summarise(max = max,
sum = cumsum(sum),
date = date) %>%
ggplot()+
geom_line(aes(x = date, y = max), size = 0.8, color = "darkslategray")+
geom_line(aes(x = date, y = sum/1000000), size = 0.8, color = "darkslateblue")+
geom_point(aes(x = date, y = sum/1000000), size = 0.8, color = "darkslateblue")+
geom_hline(yintercept=0, linetype="dashed", color = "grey")+
scale_y_continuous(sec.axis = sec_axis(~.*1,name = "Anzahl Impfungen kumuliert [Mio]"))+
scale_x_date(labels = date_format("%b %y"),
date_breaks = ("2 weeks"))+
theme_classic()+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
labs(
title = "Mobilitätsaufkommen vs Impfverlauf",
subtitle = "Parks & Naherholungsgebiete",
y = "Abweichung zum Rezerenzwert [%]"
)
mobility_vaccine %>%
group_by(date) %>%
summarise(max = mean(transit_stations),
sum = sum(Anzahl)) %>%
summarise(max = max,
sum = cumsum(sum),
date = date) %>%
ggplot()+
geom_line(aes(x = date, y = max), size = 0.8, color = "darkslategray")+
geom_line(aes(x = date, y = sum/1000000), size = 0.8, color = "darkslateblue")+
geom_point(aes(x = date, y = sum/1000000), size = 0.8, color = "darkslateblue")+
geom_hline(yintercept=0, linetype="dashed", color = "grey")+
scale_y_continuous(sec.axis = sec_axis(~.*1,name = "Anzahl Impfungen kumuliert [Mio]"))+
scale_x_date(labels = date_format("%b %y"),
date_breaks = ("2 weeks"))+
theme_classic()+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
labs(
title = "Mobilitätsaufkommen vs Impfverlauf",
subtitle = "Transitstationen",
y = "Abweichung zum Rezerenzwert [%]"
)
mobility_vaccine %>%
group_by(date) %>%
summarise(max = mean(workplaces),
sum = sum(Anzahl)) %>%
summarise(max = max,
sum = cumsum(sum),
date = date) %>%
ggplot()+
geom_line(aes(x = date, y = max), size = 0.8, color = "darkslategray")+
geom_line(aes(x = date, y = sum/1000000), size = 0.8, color = "darkslateblue")+
geom_point(aes(x = date, y = sum/1000000), size = 0.8, color = "darkslateblue")+
geom_hline(yintercept=0, linetype="dashed", color = "grey")+
scale_y_continuous(sec.axis = sec_axis(~.*1,name = "Anzahl Impfungen kumuliert [Mio]"))+
scale_x_date(labels = date_format("%b %y"),
date_breaks = ("2 weeks"))+
theme_classic()+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
labs(
title = "Mobilitätsaufkommen vs Impfverlauf",
subtitle = "Arbeitsplatz",
y = "Abweichung zum Rezerenzwert [%]"
)
mobility_vaccine %>%
group_by(date) %>%
summarise(max = mean(residential),
sum = sum(Anzahl)) %>%
summarise(max = max,
sum = cumsum(sum),
date = date) %>%
ggplot()+
geom_line(aes(x = date, y = max), size = 0.8, color = "darkslategray")+
geom_line(aes(x = date, y = sum/1000000), size = 0.8, color = "darkslateblue")+
geom_point(aes(x = date, y = sum/1000000), size = 0.8, color = "darkslateblue")+
geom_hline(yintercept=0, linetype="dashed", color = "grey")+
scale_y_continuous(sec.axis = sec_axis(~.*1,name = "Anzahl Impfungen kumuliert [Mio]"))+
scale_x_date(labels = date_format("%b %y"),
date_breaks = ("2 weeks"))+
theme_classic()+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
labs(
title = "Mobilitätsaufkommen vs Impfverlauf",
subtitle = "Wohngebiete",
y = "Abweichung zum Rezerenzwert [%]"
)